Loadstar 84/084.d81/source codes/LOW BOX SOURCE

Text File | 1991-01-01 | 13.0 KB | 1,146 lines

.org $0800
;mem
.obj "toolbox $0800.o"
lda 648
cmp current'screen
beq +
jsr set'screen'table

+ jsr line'links

ldx #1
stx numbers'to'get
jsr get'number  ;get function number

lda number

cmp #11
bcc +
jmp other'table

+ cmp #0
beq help
cmp #1
beq mline
cmp #2
beq message
cmp #3
beq message'custom
cmp #4
beq screen'stash'enter
cmp #5
beq screen'restore'enter
cmp #6
beq fill'enter
cmp #7
beq box'enter
cmp #8
beq clear'line
cmp #9
beq character'swap
cmp #10
beq color'swap
rts

help jsr helpsc
rts

mline jsr move'line2
rts

message'custom ldx #6
stx numbers'to'get
jsr get'number
jsr set'message
jsr message
rts

message jsr get'string
jsr message'routine
rts

screen'stash'enter ldx #1
stx numbers'to'get
jsr get'number
jsr screen'stash
rts

screen'restore'enter ldx #1
stx numbers'to'get
jsr get'number
jsr screen'restore
rts

fill'enter ldx #5
stx numbers'to'get
jsr get'number
fill'routine jsr wait
filler jsr fill
inc number
ldx number
cpx number+1
bcc filler
rts

color'swap jsr color
rts

character'swap jsr char
rts

box'enter ldx #6
stx numbers'to'get
jsr get'number
box'routine jsr wait
boxer jsr box
inc number
ldx number
cpx number+1
bcc boxer
rts

clear'line ldx #2
stx numbers'to'get
jsr get'number
jsr wait
ldx number
- jsr 59903
inc number
ldx number
cpx number+1
bcc -
rts

other'table cmp #11
beq rvs'enter
cmp #12
beq dir'enter
cmp #13
beq file'read'enter
rts

rvs'enter ldx #5
stx numbers'to'get
jsr get'number
rvs'routine jsr wait
rvser jsr rvs
inc number
ldx number
cpx number+1
bcc rvser
rts

dir'enter ldx #1
stx numbers'to'get
jsr get'number
lda number
sta device
jsr get'string
lda #6
sta number
jsr screen'stash
lda #0
sta 212
lda #147
jsr $ffd2
jsr dir
- jsr $ffe4
beq -
lda #6
sta number
jsr screen'restore
rts

file'read'enter ldx #2
stx numbers'to'get
jsr get'number
lda number
sta device
lda number+1
sta flag
jsr get'string
lda #6
sta number
jsr screen'stash
lda #0
sta 212
lda #147
jsr $ffd2
jsr file'read
lda #6
sta number
jsr screen'restore
rts

;**** get number from BASIC ****

get'number ldx #0
stx current'number

- jsr $aefd
jsr $ad8a
jsr $b7f7
lda $14  ; got it!

ldx current'number
sta number,x
inc current'number
dec numbers'to'get
beq +
bne -
+ rts

;***** get string from BASIC ****

get'string jsr $aefd
jsr $ad9e
jsr $b6a3

ldx $22
ldy $23
stx 251
sty 252
cmp #41
bcc +
lda #40
+ sta string'length
tay

- lda (251),y
sta string3,y
dey
bpl -
rts

;**** Line Links ****

line'links ldy #24
- lda 217,y
ora #128
sta 217,y
dey
bpl -
rts

;**** wait ****
wait lda 53265
bpl wait
rts

;**** SCREEN STASH ****

screen'stash ldy number
cpy #11; ahem!  there are only 11 screens (0-8)
bcc +
rts

+ sei
ldx #0
lda 1
sta temp
stx 1
lda screens,y
stx 253
sta 254;  dest screen
lda 648
sta 252;  source screen
ldy #0
sty 251

;begin copying

- lda (251),y
sta (253),y
iny
bne -
inx
inc 254
inc 252

cpx #4
bne -
ldx #0

lda #>55296
sta 252

- dec 1
lda (251),y
inc 1
sta (253),y
iny
bne -
inc 252
inc 254
inx
cpx #4
bne -

lda temp
sta 1
cli
lda 53280
ldy number
sta border,y
lda 53281
sta background,y
rts

screen'restore  ldy number
cpy #11; ahem!  there are only 11 screens (0-8)
bcc +
rts

/ lda 53265
bpl -

sei
ldx #0
lda 1
sta temp
stx 1
lda screens,y
stx 253
sta 254;  source screen
lda 648
sta 252;  dest screen
ldy #0
sty 251

;begin copying

- lda (253),y
sta (251),y
iny
bne -
inx
inc 254
inc 252

cpx #4
bne -
ldx #0

lda #>55296
sta 252

- lda (253),y
dec 1
sta (251),y
inc 1
iny
bne -
inc 252
inc 254
inx
cpx #4
bne -

lda temp
sta 1
cli

ldy number
lda border,y
sta 53280
lda background,y
sta 53281
rts

;****** HELP ******

helpsc lda #6
sta number
jsr screen'stash

lda #0
sta 53280
sta 53281

lda #0
sta 212
lda #147
jsr $ffd2

lda #>chunk'o'text
sta 252
lda #<chunk'o'text
sta 251
ldy #0

- lda (251),y

beq finis
cmp #"\"
beq switch'to'white
cmp #"@"
beq switch'to'cyan'reverse

bump'help jsr $ffd2
cmp #13
bne +
lda 214
cmp #23
bne +
sty temp
jsr press
lda #0
sta 212
lda #147
jsr $ffd2
ldy temp

+ iny
bne -
inc 252
bne -

switch'to'white lda #1
sta 646
lda #0
sta 199
jmp bump'help

switch'to'cyan'reverse lda #3
sta 646
sta 199
jmp bump'help

finis lda #0
sta 198

jsr press

lda #6
sta number
jsr screen'restore
rts

;**** move line ****
;from line, to line

move'line2 ldx #2
stx numbers'to'get
jsr get'number
jsr wait
jsr move
rts

move lda number
bpl +
sec
sbc #128
+ cmp #25
bcc +
rts
+ asl
tay
lda color'mem,y
sta 251
lda screen'mem,y
sta 253
iny
lda color'mem,y
sta 252
lda screen'mem,y
sta 254

ldy #39
- lda (253),y
sta string,y
lda (251),y
sta string2,y
dey
bpl -

ldx number
bmi +
jsr 59903

+ lda number+1
asl
tay
lda color'mem,y
sta 251
lda screen'mem,y
sta 253
iny
lda color'mem,y
sta 252
lda screen'mem,y
sta 254

ldy #39
- lda string,y
sta (253),y
lda string2,y
sta (251),y
dey
bpl -

lda #19
jmp $ffd2


;**** FILL **** line,to line,col,to col,color

fill lda number
cmp #25
bcc +
rts
+ asl
tay
lda color'mem,y
sta 251
iny
lda color'mem,y
sta 252


ldy number+3
lda number+4
- sta (251),y
dey
bmi +
cpy number+2
bcs -

+ rts

;**** BOX **** lin,tlin,col,to col,s-code,color

box lda number
asl
tay
lda color'mem,y
sta 251
lda screen'mem,y
sta 253
iny
lda color'mem,y
sta 252
lda screen'mem,y
sta 254

ldy number+3
- lda number+4
sta (253),y
lda number+5
sta (251),y
dey
bmi +
cpy number+2
bcs -
+ rts

;********** color swap ******
;color,to color

color ldx #2
stx numbers'to'get
jsr get'number

lda #>55296
sta 252
ldx #1
ldy #0
sty 251

jsr wait

- lda (251),y
and #15
cmp number
beq change'color
iny
bne -
inx
inc 252
cpx #5
bne -
rts

change'color lda number+1
sta (251),y
jmp -

;********** char swap ******
;char,to char,color

char ldx #3
stx numbers'to'get
jsr get'number

lda #>55296
sta 254
ldx #1
ldy #0
sty 251
sty 253
lda 648
sta 252

jsr wait

- lda (251),y
cmp number
beq swap
iny
bne -
inx
inc 252
inc 254
cpx #5
bne -
rts

swap lda number+1
sta (251),y
lda number+2
bmi +
sta (253),y
+ jmp -

;**** MESSAGE ****

message'routine lda #6
sta number
jsr screen'stash

lda fade'screen
beq naw
lda #0
sta number
sta number+2
lda #24
sta number+1
lda #39
sta number+3
lda fade'color
sta number+4
jsr fill'routine

naw ldy #5
- lda box'parms,y
sta number,y
dey
bpl -

jsr box'routine

lda string'length
lsr
sta string'length+1
lda #20
sec
sbc string'length+1
sta string'length+1
lda starting'line
clc
adc #1
tax
ldy string'length+1
clc

jsr plot
lda rvs'text
sta 199
lda box'color
sta 646

ldy #0

- lda string3,y
jsr $ffd2
iny
cpy string'length
bne -

- bit 197
bvs -

lda #6
sta number
jsr screen'restore
rts

;**** SET MESSAGE ****
;sys 2048,2,fade?,fade color,rvs text?,box/text col,start line,char,string


set'message lda number
sta fade'screen
lda number+1
sta fade'color
lda number+2
sta rvs'text
lda number+3
sta box'color
sta box'parms+5
lda number+4
cmp #21
bcc +
lda #20
+ sta starting'line
sta box'parms
clc
adc #3
sta box'parms+1
lda number+5
sta box'parms+4
rts

plot cpx #25
bcs +
jsr $fff0
+ rts

;**** RVS **** lin,tlin,col,to col,color <128

rvs lda number
cmp #25
bcc +
rts
+ asl
tay
lda color'mem,y
sta 251
lda screen'mem,y
sta 253
iny
lda color'mem,y
sta 252
lda screen'mem,y
sta 254

ldy number+3
- lda (253),y
eor #128
sta (253),y
lda number+4
bmi +
sta (251),y
+ dey
bmi +
cpy number+2
bcs -
+ rts

;directory

dir lda string'length
ldy #>string3
ldx #<string3
jsr $ffbd;          setnam
lda #17;            file number
ldx device
ldy #0
jsr $ffba; n        setlfs
jsr $ffc0;           open
ldx #17
jsr $ffc6;

jsr $ffcf;            get byte
jsr $ffcf;             get byte;        skip first two bytes

first jsr $ffb7;     read status
and #64
bne dir'out

jsr $ffcf;             get byte
jsr $ffcf;             get byte;         skip two bytes

second jsr $ffb7
and #64;              eof?
bne dir'out
jsr $ffcf;             get byte
tax
jsr $ffcf;             get byte
jsr $bdcd
lda " "
jsr $ffd2

jsr $ffb7
and #64;               eof?
bne dir'out

third jsr $ffcf;             get byte
bne +

lda #13
jsr $ffd2
jmp first

+ jsr $ffd2

- lda 197
cmp #64
bne -
lda 653
bne -

jsr $ffb7
and #64
bne dir'out

jmp third

dir'out lda #17
jsr $ffc3;            close17
jsr $ffcc ;clear chan

rts

file'read lda string'length
ldy #>string3
ldx #<string3
jsr $ffbd;          setnam
lda #12;            file number
ldx device
ldy #12
jsr $ffba; n        setlfs
jsr $ffc0;           open
ldx #12
jsr $ffc6;
jsr $ffcf
jsr $ffcf

gfile ldx 197
cpx #63
bne +
- bit 197
bvc -
jmp file'out
+ jsr $ffcf;           get byte
sta temp
cmp flag
bne +
jsr press
lda #0
sta 212
lda #147
jsr $ffd2
jmp gfile
+ cmp #";"
bne +
jsr print'command
beq gfile
+ bit rvs'mode
bvc +
ldx #1
stx 199
ldx 211
bne +
sta temp
jsr reverse'line
lda temp
+ jsr $ffd2

bit auto'page
bvc file'end
cmp #13
bne file'end
lda 214
cmp #23
bne file'end
jsr press
lda #0
sta 212
lda #147
jsr $ffd2

file'end jsr $ffb7
and #64
bne file'out
beq gfile

press ldx #24
ldy #8
clc
jsr $fff0
ldy #0
sty 198
sty 199
- lda press'a'key,y
beq waitkey
jsr $ffd2
iny
bne -

waitkey lda 197
cmp #64
beq waitkey
lda #0
sta 198
rts

file'out lda #12
jsr $ffc3;            close12
jsr $ffcc ;clear chan
jsr press
rts

print'command lda 211
beq +
lda temp
rts
+ jsr $ffcf;       get byte

jsr get'command
lda #0
rts

get'command cmp #"1"
bne +
lda #0
sta 646

rts
+ cmp #"2"
bne +
lda #1
sta 646
rts
+ cmp #"3"
bne +
lda #2
sta 646
+ cmp #"4"
bne +
lda #3
sta 646
rts
+ cmp #"5"
bne +
lda #4
sta 646
rts
+ cmp #"6"
bne +
lda #5
sta 646
rts
+ cmp #"7"
bne +
lda #6
sta 646
rts
+ cmp #"8"
bne +
lda #7
sta 646
rts

+ cmp #"!"
bne +
lda #8
sta 646
rts
+ cmp #34
bne +
lda #9
sta 646
rts
+ cmp #"#"
bne +
lda #10
sta 646
rts

+ cmp #"$"
bne +
lda #11
sta 646
rts

+ cmp #"%"
bne +
lda #12
sta 646
rts

+ cmp #"&"
bne +
lda #13
sta 646
rts

+ cmp #"'"
bne +
lda #14
sta 646
rts

+ cmp #"("
bne +
lda #15
sta 646
rts

+ cmp #"r"
bne +
lda #255
sta rvs'mode
jsr reverse'line
rts

+ cmp #"R"
bne +
lda #0
sta rvs'mode
rts

+ cmp #"a"
bne +
lda #255
sta auto'page

+ cmp #"A"
bne +
lda #0
sta auto'page
+ rts

reverse'line sty tempy
ldy #39
- lda (209),y
ora #128
sta (209),y
lda 646
sta (243),y
dey
bpl -
ldy tempy
rts

set'screen'table lda #19
jsr $ffd2
ldy #0

- lda 209
sta screen'mem,y
iny
lda 210
sta screen'mem,y
iny
lda 214
cmp #24
beq +
lda #17  ; cursor down
jsr $ffd2
jmp -
+ lda #19
jsr $ffd2
lda 648
sta current'screen

rts

device .byt 8
numbers'to'get .buf 1
current'number .buf 1
string'len .buf 2
number .buf 9
rvs'mode .byt 0
auto'page .byt 0
flag .byt 0
string .buf 40
string2 .buf 40
string3 .buf 40
temp .buf 1
tempy .buf 1
string'length .buf 2
screen .buf 1
screens .byt $a0,$a8,$b0,$b8,$c0,$c8,$d0,$d8,$e0,$e8,$f0
; message'parameters
fade'screen .byt 0
fade'color .byt 11
rvs'text .byt 1
box'color .byt 3
starting'line .byt 20
box'parms .byt 20,23,0,39,160,3
border .buf 9
background .buf 9
press'a'key .asc "press any key to continue":.byt 0
chunk'o'text .byt 147,159
.asc "\sys  2048,function,[parameter],[p],...":.byt 13,153
.asc "--------------------------------------":.byt 13,13,159
.asc "\function 0 @ help (no parameters)   ":.byt 13,13,13
.asc "\function 1 @ move line              ":.byt 13,13
.asc "sys  2048,1,line,to line":.byt 13,13,13
.asc "\function 2 @ display message        ":.byt 13,13
.asc "sys  2048,2,string$":.byt 13,13,13
.asc "\function 3 @ define message         ":.byt 13,13
.asc "sys  2048,3,fade screen,fade col,rev text,box/txt col,strt line,scrn code,string":.byt 13,13,13
.asc "\function 4 @ stash screen, bac/bord ":.byt 13,13
.asc "sys  2048,4,screen number":.byt 13,13,13
.asc "\function 5 @ restore screen,bac,bor ":.byt 13,13
.asc "sys  2048,5,screen number":.byt 13,13,13
.asc "\function 6 @ fill section of screen ":.byt 13,13
.asc "sys  2048,6,y,to y,x,to x,color":.byt 13,13,13
.asc "\function 7 @ make box               ":.byt 13,13
.asc "sys  2048,7,y,to y,x,to x,s-code,color":.byt 13,13,13
.asc "\function 8 @ clear line or range    ":.byt 13,13
.asc "sys  2048,8,start line, fin line":.byt 13,13,13
.byt 19:.asc "\function 9 @ character swap         ":.byt 13,13
.asc "sys  2048,9,char,to char,color<128":.byt 13,13
.asc "\function 10 @ color swap            ":.byt 13,13
.asc "sys  2048,10,color,to color":.byt 13,13,13
.asc "\function 11 @ reverse screen        ":.byt 13,13
.asc "sys  2048,11,y,to y,x,to x,color<128":.byt 13,13,13
.asc "\function 12 @ directory of disk     ":.byt 13,13
.asc "sys  2048,12,device,":.byt 34:.asc "$[wildcard=f-type]":.byt 34,13,13
.asc "\function 13 @ read text file        ":.byt 13,13
.asc "sys  2048,13,device,asc flag,":.byt 34:.asc "file":.byt 0
color'mem .word 55296
.word 55296+40
.word 55296+80
.word 55296+120
.word 55296+160
.word 55296+200
.word 55296+240
.word 55296+280
.word 55296+320
.word 55296+360
.word 55296+400
.word 55296+440
.word 55296+480
.word 55296+520
.word 55296+560
.word 55296+600
.word 55296+640
.word 55296+680
.word 55296+720
.word 55296+760
.word 55296+800
.word 55296+840
.word 55296+880
.word 55296+920
.word 55296+960
current'screen .byt 4
screen'mem .word 1024
.word 1024+40
.word 1024+80
.word 1024+120
.word 1024+160
.word 1024+200
.word 1024+240
.word 1024+280
.word 1024+320
.word 1024+360
.word 1024+400
.word 1024+440
.word 1024+480
.word 1024+520
.word 1024+560
.word 1024+600
.word 1024+640
.word 1024+680
.word 1024+720
.word 1024+760
.word 1024+800
.word 1024+840
.word 1024+880
.word 1024+920
.word 1024+960